;;; find-file-suggest.el --- filename suggestions based on user-defined file index
;;   
;; Author: Christian Jauvin <cjauvin@gmail.com>
;; Created: December 2008
;; Version: 1.0
;;
;; This extension performs filename matching against an index of files below a user-specified 
;; directory. It is important to state readily that this is a very unsophisticated mechanism: for 
;; instance, if you create a new file while working and want it indexed, you have to recreate the 
;; whole index explicitly. As for my own style of work, I find that it's not a serious limitation 
;; however.
;;
;; Three variables must be defined for this to work:
;;   (1) ffs-index-include-filter (regular expression)
;;   (2) ffs-index-exclude-filter (regular expression)
;;   (3) ffs-index-dir (the dir under which the index is to be defined)
;;
;; If you don't explicitly set them, you will be interactively asked to set them the first time you
;; invoke the ffs function. At any time you can rebuild the index, with different parameters, by calling 
;; the ffs-reindex interactive function.
;;
;; You can also build the index when you load Emacs, by setting the variables in your .emacs file. For 
;; instance if you'd like to index Python and SQL source files under a certain directory, but exclude files 
;; that are under '.svn' subfolders:
;;
;;   (setq ffs-index-include-filter "\\.py$\\|\\.sql$")
;;   (setq ffs-index-exclude-filter "\\.svn")
;;   (setq ffs-index-dir "c:/whatever/dir/you/want")
;;   (ffs-index)
;;
;; Once the index is created, a buffer appears with the indexed files matching your query in the minibuffer, 
;; every time you invoke the 'ffs' function. You can navigate the suggestion buffer while still typing in the 
;; minibuffer, using the up/down arrow keys, or the mouse, and <return> or click to visit the highlighted file.
;;
;; To install:
;;   (1) Put find-file-suggest.el somewhere in the load-path
;;   (2) put in your .emacs file:
;;         (require 'find-file-suggest)
;;   (3) Optionally, you can set a shortcut key, I use:
;;         (global-set-key [(control x) (meta f)] 'ffs)
;;
;; Issues:
;;    This extension works best with Emacs > 22. It works with 21 as well, but for some reason the highlighting 
;;    mechanism does not work properly, making it less visually pleasing.
;;
;; I would like to thank Justin Weiss: although working quite differently, the code from his fuzzy-find-in-project 
;; extension was my starting point for this project.
;;


(defvar ffs-mode nil)
(defvar ffs-initialized nil)
(defvar ffs-file-index nil)
(defvar ffs-index-include-filter nil)
(defvar ffs-index-exclude-filter nil)
(defvar ffs-index-dir nil)
(defvar ffs-buffer-name "*Indexed files matching your query*")

(defun ffs-command-hook ()
  (let ((q (buffer-substring-no-properties (minibuffer-prompt-end) (point-max)))) 
    (set-buffer ffs-buffer-name)
    (use-local-map ffs-result-buffer-keymap)
    (let ((buffer-read-only nil))
      (erase-buffer)
      (let ((found nil))
        (dolist (file ffs-file-index)
          (if (string-match (concat ".*" q ".*") file)
              (progn
                (insert file)
                (add-text-properties
                 (line-beginning-position) (line-end-position)
                 '(mouse-face 'highlight))
                (insert "\n")
                (setq found t))))
        (if (not found)
          (progn
            (insert "<no match>"))
          (progn
            (goto-line 1)
            (hl-line-mode t))))
      (display-buffer ffs-buffer-name))))


(defun ffs-minibuffer-setup ()
  (when (eq ffs-mode t)
    (add-hook 'post-command-hook 'ffs-command-hook nil t)
    (use-local-map ffs-keymap)))


(defun ffs-minibuffer-exit ()
  "Cleanup code when exiting the minibuffer"
  (when (eq ffs-mode t)
    ;; dont know if this is needed..
    ;(use-local-map (keymap-parent fuzzy-find-keymap))   
    (kill-buffer ffs-buffer-name)
    (setq ffs-mode nil)))


(defun ffs-initialize ()
  "Initialize the keymap and other things that need to be setup before the first run of the fuzzy file finder."
  (if (not ffs-initialized)
      (progn
        ;; minibuffer keymap
        (setq ffs-keymap (make-sparse-keymap))
        (set-keymap-parent ffs-keymap minibuffer-local-map)
        (define-key ffs-keymap (kbd "<up>") 'ffs-up)
        (define-key ffs-keymap (kbd "<down>") 'ffs-down)
        (define-key ffs-keymap (kbd "<RET>") 'ffs-pick-file)
        (define-key ffs-keymap "\C-p" 'ffs-up)
        (define-key ffs-keymap "\C-n" 'ffs-down)

        ;; results buffer keymap
        (setq ffs-result-buffer-keymap (make-sparse-keymap))
        (define-key ffs-result-buffer-keymap (kbd "<RET>") 'ffs-pick-file)
        (define-key  ffs-result-buffer-keymap [mouse-1] 'ffs-pick-file)

        (setq ffs-initialized t))))


(defun ffs-down ()
  (interactive)
  (set-buffer ffs-buffer-name)
  (let ((buffer-read-only nil))
    (progn
      (forward-line 1)
      (set-window-point (get-buffer-window ffs-buffer-name) (point)))))


(defun ffs-up ()
  (interactive)
  (set-buffer ffs-buffer-name)
  (let ((buffer-read-only nil))
    (progn
      (forward-line -1)
      (set-window-point (get-buffer-window ffs-buffer-name) (point)))))


(defun ffs-pick-file ()
  (interactive)
  (set-buffer ffs-buffer-name)
  (setq ffs-exit 'find-file)
  (setq ffs-currfile (buffer-substring-no-properties (line-beginning-position) (line-end-position)))
  (exit-minibuffer))


(defun find-file-suggest ()
  (interactive)
  (if (not ffs-file-index)
      (ffs-reindex))
  (if ffs-file-index
      (progn
        (setq ffs-mode t)
        (switch-to-buffer (get-buffer-create ffs-buffer-name))
        (setq ffs-currline 1)
        (setq ffs-currfile "")
        (ffs-initialize)
        (add-hook 'minibuffer-setup-hook 'ffs-minibuffer-setup)
        (add-hook 'minibuffer-exit-hook 'ffs-minibuffer-exit) 
        (read-string "Find indexed file: ")
        ;; this is executed after the minibuffer is exited (user hit <ret> or clicked a file)
        (cond 
         ((and (eq ffs-exit 'find-file) (not (or (string= ffs-currfile "") (string= ffs-currfile "<no match>"))))
          (progn
            (find-file ffs-currfile)))))))


(defun ffs-reindex ()
  (interactive)
  (setq ffs-index-include-filter (read-string "Include filter (regexp): " ffs-index-include-filter))
  (setq ffs-index-exclude-filter (read-string "Exclude filter (regexp): " ffs-index-exclude-filter))
  (setq ffs-index-dir (read-directory-name "Directory to index: " ffs-index-dir))
  (ffs-index))


(defun ffs-index ()
  (if (or (not ffs-index-include-filter) (not ffs-index-exclude-filter) (not ffs-index-dir))
      (error "FFS error: you must define variables 'ffs-index-include-filter', 'ffs-index-exclude-filter' and 'ffs-index-dir' before invoking function 'ffs-index'")
    (progn
      (setq ffs-file-index (ffs-index-files-below-directory ffs-index-dir))
      (if (not ffs-file-index)
          (message "FFS warning: your indexing query didn't match any files")
        ))))
  

(defun ffs-index-files-below-directory (dir)
  (message "FFS: indexing...")
  (let (file-index
        (cur-dir-list
         (directory-files-and-attributes dir t)))
    (while cur-dir-list
       ; if is directory
       (if (eq t (car (cdr (car cur-dir-list))))
           (if (or (equal "." (substring (car (car cur-dir-list)) -1)) (string-match ffs-index-exclude-filter (car (car cur-dir-list)))) 
               () ; dont go if "." or ".." or match exclude filter
           ; else descend
             (if (or (not (string-match ffs-index-exclude-filter (car (car cur-dir-list)))) (string= ffs-index-exclude-filter ""))
                 (setq file-index (append (ffs-index-files-below-directory (car (car cur-dir-list))) file-index))))
             
       ; else if is regular file, index it if it passes the include/exclude tests
         (if (and (or (string-match ffs-index-include-filter (car (car cur-dir-list))) (string= ffs-index-include-filter ""))
                  (or (not (string-match ffs-index-exclude-filter (car (car cur-dir-list)))) (string= ffs-index-exclude-filter "")))
             (setq file-index (cons (car (car cur-dir-list)) file-index))))
       
      (setq cur-dir-list (cdr cur-dir-list)))
    (message "FFS: indexing done")
    file-index))


(provide 'find-file-suggest)

